home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d11 / julia.arc / JULIA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-24  |  33.6 KB  |  1,110 lines
  1. program Julia;
  2.  
  3. { This program generates a section of the Julia Set, can save it on
  4.   disk and use existing Julia pictures to zoom further into the set }
  5.  
  6.  
  7. {$IFDEF CPU87} {$N+} {$ELSE} {$N-} {$ENDIF}
  8. uses
  9.   Crt, Graph, General, IO_Sup, PopUps,
  10.   Cmplx, mouse;
  11.  
  12.  
  13. {$IFOPT N-}
  14.   TYPE
  15.     double = real;
  16. {$ENDIF}
  17.  
  18. const
  19.   Scan_width = 359;  { 719 (max Hercules) div 2 }
  20.   Max_Scan_Lines = 349;  { PC 3270 max }
  21.   Aspect = 0.75;
  22.   Real_Length = 30;
  23.   Yes_N_No : Set of Char = ['Y','N','y','n'];
  24.   Yes : set of char = ['Y','y'];
  25.   No  : set of char = ['N','n'];
  26.   DriverPath : string = 'c:\prgm';
  27.   Mouse_Flag : boolean = false;
  28.   ResStrArray : array[0..2] of String[10] =
  29.                  ('CGAHighRes','EGALowRes','EGAHighRes');
  30.  
  31.   MainMenu : menuRec =
  32.               (row      : 1;
  33.                interval : 24;
  34.                fore     : white;
  35.                back     : green);
  36.   MainMenuText : String[23] = 'Create~File~Config~Exit';
  37.   MemWindo : popRec =
  38.               (Left  : 5;
  39.                Top   : 5;
  40.                Right : 75;
  41.                Bottom : 20;
  42.                Style : 1;
  43.                Normal : LightCyan;
  44.                Hilite : LightGray;
  45.                NormBack : Black;
  46.                HiBack  : Magenta;
  47.                Border : Red);
  48.  OpenWindo : popRec =
  49.               (Left  : 1;
  50.                Top   : 1;
  51.                Right : 80;
  52.                Bottom : 25;
  53.                Style : 1;
  54.                Normal : Green;
  55.                Hilite : LightGray;
  56.                NormBack : Black;
  57.                HiBack  : Magenta;
  58.                Border : Yellow);
  59. MouseWindo : popRec =
  60.               (Left  : 5;
  61.                Top   : 5;
  62.                Right : 75;
  63.                Bottom : 15;
  64.                Style : 1;
  65.                Normal : Green;
  66.                Hilite : LightGray;
  67.                NormBack : Black;
  68.                HiBack  : Magenta;
  69.                Border : Yellow);
  70.  GrafWindo : popRec =
  71.               (Left  : 5;
  72.                Top   : 5;
  73.                Right : 75;
  74.                Bottom : 20;
  75.                Style : 1;
  76.                Normal : Yellow;
  77.                Hilite : LightGray;
  78.                NormBack : Black;
  79.                HiBack  : Magenta;
  80.                Border : Green);
  81.   ResWindo : popRec =
  82.               (Left  : 5;
  83.                Top   : 5;
  84.                Right : 75;
  85.                Bottom : 20;
  86.                Style : 1;
  87.                Normal : Yellow;
  88.                Hilite : LightGray;
  89.                NormBack : Black;
  90.                HiBack  : Magenta;
  91.                Border : Green);
  92.  
  93. type
  94.   ResType     = (CGAHighRes,EGALowRes,EGAHighRes);
  95.   Real_String = String[Real_Length];
  96.   Color_Array = Array[0..55] of integer;
  97.   ScreenArray = Array[1..1] of byte;
  98.   ScrnDataRec = Record
  99.                   Dots_H, Dots_V, Count, Start : integer;
  100.                   Con_Real, Con_Imag,
  101.                   Low_Real, Low_Imag,
  102.                   High_Real, High_Imag : Real_String;
  103.                   ScrnSize : word;
  104.                   ResStr : String[10];
  105.                   Note : String[80];
  106.                 end;
  107.  
  108. const
  109.   Colors_2 :  Color_Array = (0, 0, 0, 0, 1, 1, 1, 1,
  110.                              0, 0, 0, 0, 1, 1, 1, 1,
  111.   { Color arrangement }      0, 0, 0, 0, 1, 1, 1, 1,
  112.   { for 2 color screens }    0, 0, 0, 0, 1, 1, 1, 1,
  113.                              0, 0, 0, 0, 1, 1, 1, 1,
  114.                              0, 0, 0, 0, 1, 1, 1, 1,
  115.                              0, 0, 0, 0, 1, 1, 1, 1);
  116.  
  117.   Colors_4 :  Color_Array = (1, 2, 1, 2, 1, 2, 3, 2, 3, 2, 3, 2,
  118.                              1, 3, 1, 3, 1, 3, 2, 1, 2, 1, 2, 1,
  119.   { Color arrangement }     3, 2, 3, 2, 3, 2, 1, 3, 1, 3, 1, 3,
  120.   { for 4 color screens }    2, 1, 2, 1, 2, 1, 3, 2, 3, 2, 3, 2,
  121.                              1, 3, 1, 3, 1, 3, 0, 0);
  122.  
  123.   Colors_16 : Color_Array = (1,  9, 1,  9, 1,  9, 1,  9,
  124.                              2, 10, 2, 10, 2, 10, 2, 10,
  125.                              3, 11, 3, 11, 3, 11, 3, 11,
  126.                              4, 12, 4, 12, 4, 12, 4, 12,
  127.                              5, 13, 5, 13, 5, 13, 5, 13,
  128.                              6, 14, 6, 14, 6, 14, 6, 14,
  129.                              7, 15, 7, 15, 7, 15, 7, 15);
  130.  
  131.   XMul : integer = 1;       { These constants determine the size of }
  132.   XDiv : integer = 1;       { the Text displayed at the bottom of }
  133.   YMul : integer = 1;       { the Graphics screen giving the limits of }
  134.   YDiv : integer = 1;       { the area being created }
  135.  
  136. var
  137.   Resolution          : ResType;
  138.   ch                  : char;
  139.   Low, High,
  140.   Con, Delta          : Complex;
  141.   IOError,
  142.   Dots_Horizontal,
  143.   Dots_Vertical,
  144.   Start_Y, Max_Count,
  145.   Color_Count,
  146.   Driver, Graph_Mode,
  147.   Max_Colors,
  148.   Max_X,   Max_Y      : integer;
  149.   Use_Color           : Color_Array;
  150.   Stop,
  151.   Picture_Loaded      : boolean;
  152.   Maus                : Mouse_Event;
  153.   HCursor,
  154.   VCursor             : pointer;
  155.   LowReal, LowImag,
  156.   HighReal, HighImag  : String[15];
  157.   File_Name           : String[80];
  158.   LimitStr            : string;
  159.   Screen_Data         : ScrnDataRec;
  160.   Data_File           : File of ScrnDataRec;
  161.   Screen_File         : File;
  162.   ScreenSize          : word;
  163.   Scrn1,
  164.   Scrn2               : ^ScreenArray;
  165.  
  166. procedure MemError(ErrCode : integer);
  167. begin
  168.   RestoreCRTMode;
  169.   PopShow(MemWindo);
  170.   if Center('There is not enough heap memory to load the Screen Into',True) then;
  171.   if Center('This could be due to too many TSR''s being loaded or an',True) then ;
  172.   if Center('Error in the program. In any case this program will now',True) then;
  173.   if Center('Abort, all files will be closed and your data will be safe',True) then;
  174.   if Center('The Error occurred in the following procedure: ',False) then;
  175.   Case ErrCode of
  176.     1 : writeln('Adjust_Values');
  177.     2 : writeln('Define_Screen');
  178.   end;
  179.   if Center('Press Any key to continue',False) then;
  180.   Ch := ReadKey;
  181.   {$I-}
  182.     Close(Data_File);
  183.     Close(Screen_File);
  184.   {$I+}
  185.   If IOResult <> 0 then;
  186.   CloseGraph;
  187.   PopErase(MemWindo);
  188.   Halt;
  189. end;  { MemError }
  190.  
  191. procedure GraphError(error_code : integer);
  192. begin
  193.   CloseGraph;
  194.   TextMode(3);
  195.   window(20,10,60,15);
  196.   TextBackground(Red);
  197.   TextColor(White);
  198.   ClrScr;
  199.   Case error_code of
  200.     -2 :  begin
  201.             writeln('Graphics Card not found .... ');
  202.             writeln('Program is aborting .....');
  203.             halt;
  204.           end;
  205.     -3 :  begin
  206.             writeln('Graphics Drivers Not Found!');
  207.             writeln('Enter Name of Directory containing *.BGI files');
  208.             readln(DriverPath);
  209.             Window(1,1,80,25);
  210.             Driver := Detect;
  211.             Initgraph(Driver,Graph_Mode,DriverPath);
  212.           end;
  213.     -4 :  begin
  214.             writeln('Invalid Graphics Driver ...');
  215.             writeln('Program is aborting ...');
  216.             halt;
  217.           end;
  218.     -5 :  begin
  219.             writeln('Insufficient Memory to load Graphics driver');
  220.             writeln('Program is aborting ...');
  221.             halt;
  222.           end;
  223.     else
  224.     begin
  225.       writeln('Graphics error encountered!  Error #',Error_Code);
  226.       writeln('Program is aborting ...');
  227.       halt;
  228.     end;
  229.   end;      { case }
  230. end;        { GraphError }
  231.  
  232. procedure GenCursor;
  233. var
  234.   Cursize : word;
  235. begin
  236.   SetColor(GetMaxColor);
  237.   line(0,0,0,Max_Y);
  238.   Cursize := ImageSize(0,0,1,Max_Y);
  239.   GetMem(VCursor, Cursize);
  240.   GetImage(0,0,1,Max_Y,VCursor^);
  241.   ClearViewPort;
  242.   line(0,0,GetMaxX,0);
  243.   Cursize := ImageSize(0,0,GetMaxX,1);
  244.   GetMem(HCursor, Cursize);
  245.   GetImage(0,0,GetMaxX,1,HCursor^);
  246.   ClearViewPort;
  247.   setColor(GetMaxColor-1);
  248. end;       { GenCursor }
  249.  
  250. procedure Evnt_Handler
  251.             (Flags, cs, ip, ax, bx, cx, dx, si, di, ds, es, bp : word);
  252. { the above parameters are required by all interrupt type handlers }
  253. interrupt;   { declare this an interrupt handler }
  254. begin
  255.   Maus.event      := ax;
  256.   Maus.btnstatus := bx;
  257.   Maus.horiz     := cx;
  258.   Maus.vert      := dx;
  259.   inline (                { exit any mouse handler as follows }
  260.     $8b/$e5/              { Mov sp,bp }
  261.     $5d/                  { Pop bp }
  262.     $07/                  { Pop es }
  263.     $1f/                  { Pop ds }
  264.     $5f/                  { Pop di }
  265.     $5e/                  { Pop si }
  266.     $5a/                  { Pop dx }
  267.     $59/                  { Pop cx }
  268.     $5b/                  { Pop bx }
  269.     $58/                  { Pop ax }
  270.     $cb );                { RETF   }
  271. end;        { Evnt_Handler }
  272.  
  273. procedure Welcome_Screen;
  274. begin
  275.   TextMode(3);
  276.   PopShow(OpenWindo);
  277.   Writeln;
  278.   TextColor(Yellow);
  279.   if Center('Welcome to JULIA SETS',True) THEN;
  280.   if Center('Version 4.0',True) then;
  281.   TextColor(LightCyan);
  282.   writeln;
  283.   writeln(' This Program is designed to let you explore the extraordinary world of the');
  284.   writeln(' Mandelbrot and Julia sets.  These sets of Complex numbers are defined as');
  285.   writeln(' the set of numbers whose value never exceeds 2 when repeatedly subjected');
  286.   writeln(' to the formula z = z',chr(253),' + c.  The sets exist in the region ');
  287.   writeln(' between -2 to 2 on the imaginary axis and -2 and 2 on the real axis of the');
  288.   writeln(' Complex plane.  The Complex Plane is described by a Imaginary number line ');
  289.   writeln(' (the vertical or y axis) and a Real number line (the horizontal or x axis)');
  290.   writeln(' In the program you will be asked to set the limits for the Real and ');
  291.   writeln(' Imaginary axes, so values between -2 and 2 are expected for both. The Julia');
  292.   writeln(' Set differs from the Mandelbrot set in that the value of c is specified by');
  293.   writeln(' user.  If a zero value is specified the program supplies c as the value of');
  294.   writeln(' point being evaluated, this gives the Mandelbrot set. You must give the #');
  295.   writeln(' of iterations to be used before the program gives up on a given point and');
  296.   writeln(' calls it a member of a set.  Reasonable values for large regions are in the');
  297.   writeln(' 30-50 range, as you zoom in to smaller and smaller areas, you may increase ');
  298.   writeln(' to 100-200 to get better resolution.  If you don''t have a math coprocessor');
  299.   writeln(' it will take a long time to do 30 iterations and almost forever to do > 100');
  300.   writeln(' Good Luck and enjoy the show ');
  301.   TextColor(Yellow);
  302.   if Center('Press Any Key to Continue',False) then;
  303.   ch := ReadKey;
  304.   PopErase(OpenWindo);
  305. end;  { Welcome_Screen }
  306.  
  307.  
  308. procedure Initialize;
  309.  
  310. { this proc checks for the graphics screen and selects a mode based on
  311.   a compromise between resolution and the number of colors.             }
  312.  
  313. var
  314.   choice  : char;
  315.   x       : integer;
  316.  
  317.   function UseMouse: boolean;
  318.   var
  319.     dummy : boolean;
  320.   begin
  321.     RestoreCrtMode;
  322.     TextColor(LightCyan);
  323.     UseMouse := False;
  324.     PopShow(MouseWindo);
  325.     ClrScr;
  326.     Dummy := Center('You seem to have a mouse attached to your system.   ',True);
  327.     Dummy := Center('Some Mice do not work properly, if you have problems',True);
  328.     Dummy := Center('try answering No to this Question                   ',True);
  329.     Dummy := Center('Would you like to use your mouse? (Y/N)             ',False);
  330.     repeat
  331.       Ch := ReadKey;
  332.     until Ch in Yes_N_No;
  333.     writeln(Ch);
  334.     if Ch in Yes then UseMouse := True;
  335.     PopErase(MouseWindo);
  336.     SetGraphMode(Graph_Mode);
  337.   end;   { UseMouse }
  338.  
  339.   function GetMode(DriverStr : string): char;
  340.   var
  341.     ch : char;
  342.   begin
  343.     PopShow(GrafWindo);
  344.     ClrScr;
  345.     if Center('This is a graphics intensive program which uses colors to show',
  346.                True) then;    { true means line feed i.e. writeln }
  347.     if Center('contrast between regions on the screen.  Your '+DriverStr+'      ',
  348.                True) then;    { false is like write }
  349.     if Center('adapter in graphics mode can only display 4 colors at a time. ',
  350.                True) then;
  351.     if Center('You may choose which 4 colors below:                          ',
  352.                True) then;
  353.     if Center('(1) Black, Bright Green, Bright Red, Yellow [Default]',
  354.                True) then;
  355.     if Center('(2) Black, Bright Cyan, Bright Magenta, White        ',
  356.                True) then;
  357.     if Center('(3) Black, Green, Red, Brown                         ',
  358.                True) then;
  359.     if Center('(4) Black, Cyan, Magenta, Light Gray                 ',
  360.                True) then;
  361.     if Center('Enter your choice (1-4) : ',
  362.                False) then;
  363.     Ch := ReadKey;
  364.     writeln(Ch);
  365.     GetMode := ch;
  366.     PopErase(GrafWindo);
  367.   end;   { GetMode }
  368.  
  369.   function GetRes(DriverStr : string): char;
  370.   var
  371.     ch : char;
  372.   begin
  373.     PopShow(ResWindo);
  374.     ClrScr;
  375.     if Center('You have a '+DriverStr+' graphics adapter capable of 640 x 350',
  376.                True) then;    { true means line feed i.e. writeln }
  377.     if Center('resolution. In order to increase speed this program normally  ',
  378.                True) then;    { false is like write }
  379.     if Center('only calculates values for half that resolution and plots 2   ',
  380.                True) then;
  381.     if Center('pixels. You may choose to have the higher resolution below at ',
  382.                True) then;
  383.     if Center('the sacrifice of calculation speed.                           ',
  384.                True) then;
  385.     if Center('(1) Low Resolution Mode (2 pixels per point) [Default]',
  386.                True) then;
  387.     if Center('(2) High Resolution Mode (1 pixel per point) (Slower) ',
  388.                True) then;
  389.     if Center('Enter your choice (1/2) : ',
  390.                False) then;
  391.     Ch := ReadKey;
  392.     writeln(Ch);
  393.     GetRes := ch;
  394.     PopErase(ResWindo);
  395.   end;   { GetRes }
  396.  
  397. begin
  398.   TextMode(LastMode);
  399.   TextColor(LightGreen);
  400.   TextBackground(Black);
  401.   DirectVideo := False;
  402.   File_Name := '';
  403.   Picture_Loaded := False;
  404.   DetectGraph(Driver, Graph_Mode);
  405.   X := GraphResult;
  406.   if X <> 0 then GraphError(X);
  407.   Case Driver of
  408.     CGA,
  409.     Reserved   : begin
  410.                    Choice := GetMode('CGA');
  411.                    case choice of
  412.                      '2' : Graph_Mode := CGAC1;
  413.                      '3' : Graph_Mode := CGAC2;
  414.                      '4' : Graph_Mode := CGAC3;
  415.                      else Graph_Mode := CGAC0;
  416.                    end;    { case }
  417.                  end;
  418.     MCGA       : begin
  419.                    Choice := GetMode('MCGA');
  420.                    case choice of
  421.                      '2' : Graph_Mode := MCGAC1;
  422.                      '3' : Graph_Mode := MCGAC2;
  423.                      '4' : Graph_Mode := MCGAC3;
  424.                      else Graph_Mode := MCGAC0;
  425.                    end;    { case }
  426.                  end;
  427.     EGA        : begin
  428.                    Graph_Mode := EGAHi;
  429.                    Choice := GetRes('EGA');
  430.                    case choice of
  431.                      '2' : Resolution := EGAHighRes;
  432.                      else Resolution := EGALowRes;
  433.                    end;  { case }
  434.                  end;
  435.     EGA64      : begin
  436.                    Graph_Mode := EGA64Lo;
  437.                    Choice := GetRes('EGA');
  438.                    case choice of
  439.                      '2' : Resolution := EGAHighRes;
  440.                      else Resolution := EGALowRes;
  441.                    end;  { case }
  442.                  end;
  443.     VGA        : begin
  444.                    Graph_Mode := VGAMed;
  445.                    Choice := GetRes('VGA');
  446.                    case choice of
  447.                      '2' : Resolution := EGAHighRes;
  448.                      else Resolution := EGALowRes;
  449.                    end;  { case }
  450.                  end;
  451.     ATT400     : begin
  452.                    Choice := GetMode('ATT400');
  453.                    case choice of
  454.                      '2' : Graph_Mode := ATT400C1;
  455.                      '3' : Graph_Mode := ATT400C2;
  456.                      '4' : Graph_Mode := ATT400C3;
  457.                      else Graph_Mode := ATT400C0;
  458.                    end;    { case }
  459.                  end;
  460.     PC3270     : Graph_Mode := PC3270Hi;
  461.     HercMono   : Graph_Mode := HercMonoHi;
  462.   end;
  463.   InitGraph(Driver,Graph_Mode,DriverPath);
  464.   X := GraphResult;
  465.   if X <> 0 then GraphError(X);
  466.   case Driver of
  467.     CGA, MCGA, Reserved,
  468.     ATT400 : begin
  469.                Color_Count := 54;
  470.                Use_Color := Colors_4;
  471.                Max_Colors := 3;
  472.                Max_X := GetMaxX;
  473.                XMul := 2;
  474.                XDiv := 3;
  475.                Resolution := CGAHighRes;
  476.              end;
  477.     EGA, VGA,
  478.     EGA64  : begin
  479.                Color_Count := 56;
  480.                Use_Color := Colors_16;
  481.                Max_Colors := 15;
  482.                if Resolution = EGAHighRes then
  483.                  Max_X := GetMaxX
  484.                else Max_X := GetMaxX div 2;
  485.              end;
  486.     else
  487.       begin
  488.         Color_Count := 56;
  489.         Use_Color := Colors_2;
  490.         Max_Colors := 1;
  491.         Max_X := GetMaxX div 2;
  492.         Resolution := EGALowRes;
  493.       end;
  494.   end;   { case }
  495.   SetUserCharSize(XMul,XDiv,YMul,YDiv);
  496.   SetTextStyle(SmallFont,HorizDir,UserCharSize);
  497.   Max_Y := GetMaxY - TextHeight('Low Real')-2;
  498.   If Reset_Mse <> 0 then
  499.     if UseMouse then
  500.       Mouse_Flag := True;
  501.   GenCursor;
  502.   RestoreCrtMode;
  503.   Scrn1 := Nil;
  504.   Scrn2 := Nil;
  505. end;      { Initialize }
  506.  
  507. procedure ClrScrnMem;
  508. begin
  509.   if Scrn1 <> nil then
  510.   begin
  511.     freemem(Scrn1,ScreenSize);
  512.     freemem(Scrn2,ScreenSize);
  513.     Scrn1 := Nil;
  514.     Scrn2 := Nil;
  515.   end;
  516. end;  { ClrScrnMem }
  517.  
  518. procedure Graphics_Cursor(ix,iy:  integer);
  519.     { Puts the graphics cursor at ix, iy,       }
  520.     { which are x and y expressed as integers.  }
  521. var
  522.   x, y : integer;
  523. begin
  524.   MoveTo(ix,iy);
  525.   putImage(ix,0,VCursor^,XORput);
  526.   putImage(0,iy,HCursor^,XORput);
  527. end;     { Graphics_Cursor }
  528.  
  529. procedure Move_Cursor(var x, y : integer; FileRes : string);
  530. var
  531.   ch : char;
  532. begin
  533.   Stop := False;
  534.   if Mouse_Flag then
  535.   begin
  536.     If Reset_Mse <> 0 then
  537.       Set_Proc_Mse($0014,Seg(Evnt_Handler),Ofs(Evnt_Handler));
  538.     Maus.Event := 0;
  539.     if (FileRes = 'CGAHighRes') or (FileRes = 'EGALowRes') then
  540.       Put_Mse(x * 2,y)
  541.     else
  542.       Put_Mse(x,y);
  543.     Show_Mse;
  544.   end
  545.   else
  546.   begin
  547.     if (FileRes = 'EGALowRes') then
  548.        x := x * 2;
  549.     Graphics_Cursor(x, y);
  550.   end;
  551.   repeat
  552.     if Mouse_Flag then
  553.       if Maus.Event = 4 then
  554.       begin
  555.          x := Maus.Horiz;
  556.          if (FileRes = 'CGAHighRes') then x := x div 2;
  557.          y := Maus.Vert;
  558.          Maus.Event := 0;
  559.          Stop := True;
  560.          Hide_Mse;
  561.        end
  562.        else
  563.          if Maus.Event = $10 then
  564.          begin
  565.            x := 9999;
  566.            Maus.Event := 0;
  567.            Stop := True;
  568.            Hide_Mse;
  569.          end else
  570.     else
  571.       if KeyPressed then
  572.       begin
  573.         ch := ReadKey;
  574.         case ch of
  575.           #0 : begin
  576.                  ch := ReadKey;
  577.                  case ch of
  578.                    #72 : dec(y);                { up arrow }
  579.                    #80 : inc(y);                { down arrow }
  580.                    #75 : dec(x);                { left arrow }
  581.                    #77 : inc(x);                { right arrow }
  582.                  end;  { case Inner }
  583.                end;   { #0 }
  584.          '8' : dec(y,10);                       { shift up arrow }
  585.          '4' : dec(x,10);                       { shift left arrow }
  586.          '6' : inc(x,10);                       { shift right arrow }
  587.          '2' : inc(y,10);                       { shift down arrow }
  588.          #13 : Stop := True;                    { Return to enter point }
  589.          #27 : begin                            { ESC to start process  }
  590.                  x := 9999;                     { again }
  591.                  Stop := True;
  592.                end;
  593.         end; { Case Outer }
  594.         if ((x < 0) or (x > Max_X)) and (Stop = False) then
  595.            x := abs(-Max_X + abs(x));
  596.         if (y < 0) or (y > Max_Y) then
  597.            y := abs(-Max_Y + abs(y));
  598.         Graphics_Cursor(GetX,GetY);
  599.         Graphics_Cursor(x,y);
  600.       end;   { if keypressed }
  601.   until stop;
  602.   if (FileRes = 'EGALowRes') then
  603.      x := x div 2;
  604. end;      { Move_Cursor }
  605.  
  606. procedure Plot(X, Y : integer; color : word);
  607. { this proc plots points on the screen. For high resolution width screens
  608.   two adjacent pixels are set. }
  609.  
  610. begin
  611.   case Resolution of
  612.     EGAHighRes,
  613.     CGAHighRes : putpixel(X,Y,Color);
  614.     else
  615.     begin
  616.       PutPixel(X*2,Y, Color);
  617.       PutPixel(X*2+1,Y, Color);
  618.     end;
  619.   end;    { case }
  620. end;    { Plot }
  621.  
  622. procedure Put_Limits;
  623. begin
  624.   Str(Low.R:15:12,LowReal);
  625.   Str(Low.I:15:12,LowImag);
  626.   Str(High.R:15:12,HighReal);
  627.   Str(High.I:15:12,HighImag);
  628.   SetColor(GetMaxColor);
  629.   SetTextJustify(LeftText,BottomText);
  630.   SetUserCharSize(XMul,XDiv,YMul,YDiv);
  631.   SetTextStyle(SmallFont,HorizDir,UserCharSize);
  632.   LimitStr := 'Real: '+LowReal+' ~ '+HighReal+'; Imag: '+LowImag+' ~ '+
  633.                HighImag;
  634.   OutTextXY(0,GetMaxY-2,LimitStr);
  635. end;
  636.  
  637. procedure Define_Screen;
  638. { this proc defines the area of the Julia set to be viewed.
  639.   it can either be typed in at the keyboard, loaded as a partially
  640.   completed screen, or as a smaller Sector of a completed picture  }
  641.  
  642. var
  643.   IOError,
  644.   x, y     : integer;
  645.   temp,
  646.   ratio    : double ;
  647.   Complete : boolean;
  648.   FileRes  : String[10];
  649.  
  650.   procedure No_Blank(var RS : Real_String);
  651.   { removes leading blanks from Real_Strings }
  652.   var
  653.     i : integer;
  654.   begin
  655.     i := 1;
  656.     while RS[i] = ' ' do
  657.       inc(i);
  658.     Delete(RS,1,i-1);
  659.   end;      { No_Blank }
  660.  
  661.   procedure Adjust_Values;
  662.   var
  663.     temp, ratio : double;
  664.   begin
  665.     if Low.R > High.R then
  666.     begin
  667.       temp   := Low.R;
  668.       Low.R  := High.R;
  669.       High.R := temp;
  670.     end;
  671.     if Low.I > High.I then
  672.     begin
  673.       temp := Low.I;
  674.       Low.I := High.I;
  675.       High.I := temp;
  676.     end;
  677.     Sub_Comp(High,Low,Delta);
  678.     Ratio := Abs(Delta.I / Delta.R);
  679.     if Ratio >= Aspect then
  680.     begin
  681.       Dots_Horizontal := Round((Max_X + 1)*Aspect/Ratio)-1;
  682.       Dots_Vertical := Max_Y;
  683.     end
  684.     else
  685.     begin
  686.       Dots_Vertical := Round((Max_Y + 1)*Ratio/Aspect)-1;
  687.       Dots_Horizontal := Max_X;
  688.     end;
  689.     SetGraphMode(Graph_Mode);
  690.     case Resolution of
  691.       EGAHighRes,
  692.       CGAHighRes : ScreenSize := ImageSize(0,0,Dots_Horizontal,Dots_Vertical div 2);
  693.       else  ScreenSize := ImageSize(0,0,Dots_Horizontal * 2, Dots_Vertical div 2);
  694.     end;    { case }
  695.     if MaxAvail < 2 * ScreenSize then MemError(1);
  696.   end;    { Adjust_Values }
  697.  
  698.   procedure Sub_Picture;
  699.   { allows the user to select a sub section of the completed screen to
  700.     be enlarged, effectively zooming in on an area of interest }
  701.   var
  702.     ch                : char;
  703.     TempLow, TempHigh : Complex;
  704.     x, y              : integer;
  705.   begin
  706.     File_Name := '';
  707.     x := Dots_horizontal div 2;
  708.     y := Dots_Vertical div 2;
  709.     Sub_Comp(High, Low, Delta);
  710.     Move_Cursor(x, y, FileRes);
  711.     if x > Max_X then
  712.     begin
  713.       Sub_Picture;
  714.       Exit;
  715.     end;
  716.     if (FileRes = 'EGALowRes') and (Resolution = EGAHighRes) then
  717.       plot(x*2, y, Max_Colors)
  718.     else
  719.       Plot(x, y, Max_Colors);
  720.     { calculate new lower limits }
  721.     TempLow.R := Low.R + (Delta.R * x / (Dots_Horizontal + 1));
  722.     TempLow.I := High.I - (Delta.I * y / (Dots_Vertical + 1));
  723.     Move_Cursor(x, y, FileRes);
  724.     if x > Max_X then
  725.     begin
  726.       Sub_Picture;
  727.       Exit;
  728.     end;
  729.     Plot(x, y, Max_Colors);
  730.     High.R := Low.R + (Delta.R * x / (Dots_Horizontal + 1));
  731.     High.I := High.I - (Delta.I * y / (Dots_Vertical + 1));
  732.     Low := TempLow;
  733.     Adjust_Values;
  734.     with Screen_Data do
  735.     begin
  736.       Start_Y := 0;
  737.       Dots_H := Dots_Horizontal;
  738.       Dots_V := Dots_Vertical;
  739.       Count := Max_Count;
  740.       Str(Low.R, Low_Real);
  741.       Str(Low.I, Low_Imag);
  742.       Str(High.R, High_Real);
  743.       Str(High.I, High_Imag);
  744.       Str(Con.R, Con_Real);
  745.       Str(Con.I, Con_Imag);
  746.       No_Blank(Low_Imag);
  747.       No_Blank(Low_Real);
  748.       No_Blank(High_Imag);
  749.       No_Blank(High_Real);
  750.       ScrnSize := ScreenSize;
  751.       ResStr := ResStrArray[Ord(Resolution)];
  752.     end;  { with }
  753.     RestoreCrtMode;
  754.     write('Maximum iteration count = ',Max_Count, '. Change it? (Y/N) ');
  755.     repeat
  756.       ch := readkey;
  757.     until ch in Yes_N_No;
  758.     writeln(ch);
  759.     if ch in Yes then
  760.     begin
  761.       repeat
  762.         write('Enter Maximum iteration count: ');
  763.         {$I-}
  764.         readln(Max_Count)
  765.         {$I+}
  766.       until IOResult = 0;
  767.       if Max_Count < 10 then Max_Count := 10;
  768.       Screen_Data.Count := Max_Count;
  769.     end;
  770.     writeln('Current Constant is : Real: ',Con.R:7:4,' Imaginary: ',Con.I:7:4);
  771.     write('Change it (Y/N) : ');
  772.     Repeat
  773.       ch := readkey;
  774.     until ch in Yes_N_No;
  775.     writeln(ch);
  776.     if ch in Yes then
  777.     begin
  778.       repeat
  779.         write('Enter the real constant part : ');
  780.         {$I-}
  781.         Readln(Con.R);
  782.         {$I+}
  783.       until IOResult = 0;
  784.       repeat
  785.         write('Enter the imaginary constant part : ');
  786.         {$I-}
  787.         Readln(Con.I);
  788.         {$I+}
  789.       until IOResult = 0;
  790.     end;
  791.     write('Enter Note :  ');
  792.     Readln(Screen_Data.Note);
  793.     SetGraphMode(Graph_Mode);
  794.   end;  { Sub_Picture }
  795.  
  796. begin        { Define_Screen }
  797.   Complete := True;
  798.   ch := 'N';
  799.   if Picture_Loaded then
  800.   begin
  801.     write('Use Picture in Memory? (Y/N) ');
  802.     repeat
  803.       ch := readkey;
  804.     until ch in Yes_N_No;
  805.     writeln(ch);
  806.   end;
  807.   if ch in No then
  808.   begin
  809.     write('Load a picture file? (Y/N) ');
  810.     repeat
  811.       ch := readkey;
  812.     until ch in Yes_N_No;
  813.     writeln(ch);
  814.     if ch in Yes then
  815.     begin     { load a picture file }
  816.       repeat
  817.         File_Name := Get_FileName('','Jul');
  818.         if Pos('.',File_Name) <> 0 then
  819.           Delete(File_Name,Pos('.',File_Name),4);
  820.         Assign(Data_File, File_Name+'.Jul');
  821.         {$I-}
  822.           Reset(Data_File);
  823.         {$I+}
  824.         IOError := IOResult;
  825.         if IOError = 0 then
  826.         begin
  827.           {$I-}
  828.             Read(Data_File, Screen_Data);
  829.           {$I+}
  830.           IOError := IOResult;
  831.           if IOError <> 0 then
  832.           begin
  833.             writeln('Old File Format Can Not Be read');
  834.             Delay(2500);
  835.           end;
  836.         end;
  837.       until IOError = 0;
  838.       ClrScrnMem;
  839.       ScreenSize := Screen_Data.ScrnSize;
  840.       if MaxAvail < 2 * ScreenSize then MemError(2);
  841.       GetMem(Scrn1,ScreenSize);
  842.       GetMem(Scrn2,ScreenSize);
  843.       Assign(Screen_File, File_Name+'.Scr');
  844.       {$I-}
  845.         Reset(Screen_File,ScreenSize);
  846.       {$I+}
  847.       If IOResult <> 0 then
  848.       begin
  849.         write('IO Error on opening Screen File');
  850.         halt;
  851.       end;
  852.       BlockRead(Screen_File,Scrn1^,1,IOError);
  853.       if IOError <> 1 then
  854.       begin
  855.         write('Error Reading Screen Image File');
  856.         Close(Data_File);
  857.         Close(Screen_File);
  858.         Halt;
  859.       end;
  860.       BlockRead(Screen_File,Scrn2^,1,IOError);
  861.       if IOError <> 1 then
  862.       begin
  863.         write('Error Reading Screen Image File');
  864.         Close(Data_File);
  865.         Close(Screen_File);
  866.         Halt;
  867.       end;
  868.       Close(Data_File);
  869.       Close(Screen_File);
  870.       Picture_Loaded := True;
  871.     end
  872.     else
  873.     begin
  874.       repeat
  875.         write('Enter range for the real (Horiz.) axis : ');
  876.         {$I-}
  877.           readln(Low.R, High.R);
  878.         {$I+}
  879.       until IOResult = 0;
  880.       if Low.R > High.R then
  881.       begin
  882.         temp := Low.R;
  883.         Low.R := High.R;
  884.         High.R := temp;
  885.       end;
  886.       repeat
  887.         write('Enter range for the imaginary (vert.) axis : ' );
  888.         {$I-}
  889.           readln(Low.I, High.I);
  890.         {$I+}
  891.       until IOResult = 0;
  892.       if Low.I > High.I then
  893.       begin
  894.         temp := Low.I;
  895.         Low.I := High.I;
  896.         High.I := temp;
  897.       end;
  898.       repeat
  899.         write('Enter maximum iteration count : ');
  900.         {$I-}
  901.           readln(Max_Count);
  902.         {$I+}
  903.       until IOResult = 0;
  904.       if Max_Count < 10 then Max_Count := 10;
  905.       repeat
  906.         writeln('Enter the Values for the Constant to be added to the Equation Below');
  907.         writeln('Zero gives the MandelBrot Set.  Enter the real part and the imaginary');
  908.         write('part separated by a space (i.e. 0 0) : ');
  909.         {$I-}
  910.         Readln(Con.R, Con.I);
  911.         {$I+}
  912.       until IOResult = 0;
  913.       write('Enter Note : ');
  914.       Readln(Screen_Data.Note);
  915.       Start_Y := 0;
  916.       Adjust_Values;
  917.       with Screen_Data do
  918.       begin
  919.         Dots_H := Dots_Horizontal;
  920.         Dots_V := Dots_Vertical;
  921.         Count := Max_Count;
  922.         Str(Low.R, Low_Real);
  923.         Str(Low.I, Low_Imag);
  924.         Str(High.R, High_Real);
  925.         Str(High.I, High_Imag);
  926.         Str(Con.R, Con_Real);
  927.         Str(Con.I, Con_Imag);
  928.         No_Blank(Low_Imag);
  929.         No_Blank(Low_Real);
  930.         No_Blank(High_Imag);
  931.         No_Blank(High_Real);
  932.         ScrnSize := ScreenSize;
  933.         ResStr := ResStrArray[Ord(Resolution)];
  934.       end;  { with }
  935.       Picture_Loaded := False;
  936.       File_Name := '';
  937.     end    { else }
  938.   end;   { if ch in No then }
  939.   if Picture_Loaded then
  940.   begin    { dump picture to screen }
  941.     with Screen_Data do
  942.     begin
  943.       Start_Y := Start;
  944.       Max_Count := Count ;
  945.       Dots_Vertical := Dots_V;
  946.       Dots_Horizontal := Dots_H;
  947.       Val(Low_Real,Low.R,X);
  948.       Val(Low_Imag,Low.I,X);
  949.       Val(High_Real,High.R,X);
  950.       Val(High_Imag,High.I,X);
  951.       Val(Con_Real,Con.R,X);
  952.       Val(Con_Imag,Con.I,X);
  953.       FileRes := ResStr;
  954.     end;
  955.     if Start_Y <= Dots_Vertical then
  956.     begin
  957.       write('Picture File is Incomplete, Do you want to complete the picture (Y/N) ');
  958.       repeat
  959.         ch := readkey;
  960.       until ch in Yes_N_No;
  961.       writeln(ch);
  962.       if ch in Yes then Complete := False
  963.       else Complete := True;
  964.     end;
  965.     SetGraphMode(Graph_Mode);
  966.     PutImage(0,0,Scrn1^,NormalPut);
  967.     PutImage(0,Dots_Vertical div 2 + 1,Scrn2^,NormalPut);
  968.     ClrScrnMem;
  969.     if Complete then
  970.     begin
  971.       Put_Limits;
  972.       Sub_Picture;
  973.     end
  974.     else
  975.       Sub_Comp(High,Low,Delta);
  976.   end;
  977.   Delta.R := Delta.R / (Dots_Horizontal + 1);
  978.   Delta.I := Delta.I / (Dots_Vertical + 1 );
  979. end;       { Define_screen }
  980.  
  981. procedure Generate;
  982. { generates the screen display.  The section marked 1* is where code has been
  983.   optimized by putting the complex number math instructions in this procedure
  984.   rather than calling the procedures in the Cmplx unit }
  985. var
  986.   Done : boolean;
  987.   x, y, PointColor, Count : integer;
  988.   Z_Point, C_Point: Complex;
  989.   Temp : Double;
  990.   Constant : ^Complex;
  991.  
  992. begin
  993.   Done := False;
  994.   Put_Limits;
  995.   Plot(Dots_Horizontal, Dots_Vertical, Max_Colors);
  996.   C_Point.I := High.I - Start_Y * Delta.I;
  997.   Y := Start_Y;
  998.   if (Con.R = 0) and (Con.I = 0) then
  999.     Constant := @C_Point
  1000.   else
  1001.     Constant := @Con;
  1002.   while (Y <= Dots_Vertical) and NOT KeyPressed do
  1003.   begin
  1004.     C_Point.R := Low.R - Delta.R;
  1005.     for x := 0 to Dots_Horizontal do
  1006.     begin
  1007.       Plot(x, y, Max_Colors);
  1008.       C_Point.R := C_Point.R + Delta.R;
  1009.       Z_Point := C_Point;
  1010.       Count := 0;
  1011.       while (Count <= Max_Count) and (Square_Size_Of_C(Z_Point) < 4.0) do
  1012.       begin
  1013.         Temp := Sqr(Z_point.R) - Sqr(Z_Point.I) ;
  1014.         Z_Point.I := 2.0 * Z_Point.I * Z_Point.R + Constant^.I;
  1015.         Z_Point.R := Temp + Constant^.R;
  1016.         Count := Succ(Count);
  1017.       end;
  1018.       if Count < Max_Count then
  1019.            PointColor := Use_Color[Count mod Color_Count]
  1020.       else PointColor := 0;
  1021.       Plot(x,y,PointColor);
  1022.     end;
  1023.     C_Point.I := C_Point.I - Delta.I;
  1024.     Y := Y + 1;
  1025.   end;    { while }
  1026.   Screen_Data.Start := Y;
  1027.   ClrScrnMem;                       { Free up Previous Screen Image Mem }
  1028.   GetMem(Scrn1,ScreenSize);         { get memory needed to hold screen }
  1029.   GetMem(Scrn2,ScreenSize);         { images }
  1030.   case Resolution of                { depending on the Screen Res we must }
  1031.     EGAHighRes,                     { define the region for capture and }
  1032.     CGAHighRes : begin              { capture the screen images }
  1033.                    GetImage(0,0,Dots_Horizontal,Dots_Vertical div 2,Scrn1^);
  1034.                    GetImage(0,Dots_Vertical div 2 + 1,
  1035.                             Dots_Horizontal,Dots_Vertical,Scrn2^);
  1036.                  end;
  1037.     else begin
  1038.            GetImage(0,0,Dots_Horizontal * 2, Dots_Vertical div 2,Scrn1^);
  1039.            GetImage(0,Dots_Vertical div 2 + 1,
  1040.                     Dots_Horizontal * 2,Dots_Vertical,Scrn2^);
  1041.          end;
  1042.   end;    { case }
  1043. end;      { Generate }
  1044.  
  1045. procedure Wrap_Up;
  1046. { deals with the shutting down of a picture }
  1047. var
  1048.   x : integer;
  1049. begin
  1050.   Picture_Loaded := True;
  1051.   if KeyPressed then Sound(440)
  1052.   else
  1053.   begin
  1054.     Sound(660);
  1055.     Delay(20);
  1056.     Sound(1000);
  1057.   end;
  1058.   Delay(50);
  1059.   NoSound;
  1060.   ch := ReadKey;
  1061.   RestoreCrtMode;
  1062.   Write('Save Picture? (Y/N) ');
  1063.   repeat
  1064.     ch := readkey;
  1065.   until ch in Yes_N_No;
  1066.   writeln(ch);
  1067.   if ch in Yes then
  1068.   begin
  1069.     if File_Name <> '' then
  1070.     begin
  1071.       write('Save as ',File_Name,'? (Y/N) ' );
  1072.       repeat
  1073.         ch := readkey;
  1074.       until ch in Yes_N_No;
  1075.       writeln(ch);
  1076.     end
  1077.     else ch := 'N';
  1078.     if ch in No then
  1079.       File_Name := Get_FileName('','Jul');
  1080.     if Pos('.',File_Name) <> 0 then
  1081.        Delete(File_Name,Pos('.',File_Name),4);
  1082.     Assign(Screen_File,File_Name+'.Scr');
  1083.     Rewrite(Screen_File,ScreenSize);
  1084.     Assign(Data_File,File_Name+'.JUL');
  1085.     Rewrite(Data_File);
  1086.     Write(Data_File,Screen_Data);
  1087.     BlockWrite(Screen_File,Scrn1^,1,IOError);
  1088.     BlockWrite(Screen_File,Scrn2^,1,IOError);
  1089.     Close(Data_File);
  1090.     Close(Screen_File);
  1091.   end;  { then }
  1092.   write(' Do Another ? (Y/N)');
  1093.   repeat
  1094.     ch := readkey;
  1095.   until ch in Yes_N_No;
  1096.   writeln(ch);
  1097. end;       { Wrap_Up }
  1098.  
  1099. BEGIN        { Main }
  1100.   Welcome_Screen;
  1101.   Initialize;
  1102.   repeat
  1103.     Define_Screen;
  1104.     Generate;
  1105.     Wrap_Up;
  1106.   until ch in No;
  1107.   RestoreCrtMode;
  1108. END.
  1109.  
  1110.